Internet Info 1993

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / sp9ker.src < prev next >

Wrap

Text File | 1988-08-16 | 40.9 KB | 930 lines

************************************************************** ** MAIN ENTRY POINT - KERMIT ONLY RUNS AS A SERVER SINCE ** ** THE SPERRY 90/60 CAN NOT INITIATE ** ** USE OF AN RTIO LINE OTHER THAN THE ** ** TERMINAL LINE ITSELF ** ** MCC TABLES AND TRANSLATION MODULES MODIFIED IN SYSTEM ** ** THIS IS NECESSARY TO INSURE THAT ALL THE CHARACTERS ** ** IN THE PRINTABLE ASCII RANGE AND THE ^A HAVE VALUES ** ** WITHIN THE EBCDIC REPRESENTATION (SEE ATOE TABLE) ** ************************************************************** SERVER CSECT STM 14,12,12(13) SAVE CALLER REGISTERS BALR 12,0 SET UP A BASE REGISTER USING *,12 ST 13,SAVE+4 SAVE MY CALLERS SAVE AREA ADR LA 13,SAVE SET UP MY SAVE AREA TO CALL SETBF 200,N WAIT LA 1,=A(PKNAK,REC) SET UP PARAMATER LIST ERRSEN L 15,=V(PACKETIO) GET READY TO GO BALR 14,15 GO DO A TRANSFER LA 1,=A(REC) ADDRESS OF PACKET RECIEVED LA 14,CHCK RETURN ADDRESS FOR FOLLOWING CHCK CLI RECTYP,C'S' IS IT A SEND INIT PACKET BNE SKIPSEND CHECK NEXT PACKET TYPE L 15,=V(RECFILE) REMOTE IS SENDING US A FILE BR 15 GO TAKE FILE FROM REMOTE TO DISK SKIPSEND CLI RECTYP,C'R' IS IT A RECIEVE INIT PACKET BNE SKIPREC NO GO TO CHECK OTHER TYPES L 15,=V(SENFILE) ROUTINE TO SEND FILE TO REMOTE BR 15 AND OFF WE GO SKIPREC CLI RECTYP,C'I' CHECK FOR AN INIT PACKET BNE SKIPINIT L 15,=V(KRMTINI) ADDRESS OF INIT HANDLER BR 15 SKIPINIT CLI RECTYP,C'G' BNE SKIPGEN CLI RECDAT,C'L' IS THIS A LOGOUT BNE SKIPGEN LA 1,=A(PKYAK,0) L 15,=V(PACKETIO) BALR 14,15 ACK THE LOGOFF COMMAND CMAND '/LOGOFF' SKIPGEN CLI RECTYP,C'Y' IS THIS AN EXTRA ACK BE WAIT YES SEND A NAK AND WAIT CLI RECTYP,C'E' BE WAIT LA 1,=A(PKERR,REC) B ERRSEN PKERR DS 0F PKELEN DC X'1B' PKESEQ DC X'00' PKETYP DC C'E' PKEDAT DC C'FUNCTION NOT IMPLEMENTED' PKNAK DS 0F DC X'03' LENGTH OF NAK PACKET TO SEND DC X'00' SEQUENCE NUMBER DC C'N' PKYAK DC X'03' PACKET LENGTH DC X'00' PACKET NUMBER DC C'Y' PACKET DATA REC DS 0F RECLEN DS XL1 RECSEQ DS XL1 RECTYP DS XL1 RECDAT DS CL150 SAVE DS 18F END KRMTINI CSECT STM 14,12,12(13) SAVE CALLER REGISTERS BALR 12,0 SET UP MY BASE REGISTER USING *,12 ST 13,SAVE+4 SAVE CALLERS SAVE ADDRESS LOCAL LA 13,SAVE SET UP A SAVE AREA FOR OTHER CALLS *************************************************************** **KERMIT INIT PACKER HANDLER ** ** ARGUMENTS (1) - 1 ADDRESS OF PACKET ** ** RECIEVED INIT PACKET ON INPUT ** ** NEXT PACKET ON RETURN ** ** EXTERNAL REFF POINT - (KRMTPARM) START OF KERMIT ** PARAM LIST ** *************************************************************** L 2,0(1) ADDRESS OF PACKET IC 3,0(2) LENGTH OF PACKET MVI PARMPKT,C' ' BLANK OUT THE LOCAL PACKET MVC PARMPKT+1(152),PARMPKT BCTR 3,0 DECREMENT FOR AN EX MOVE EX 3,MOVEPKT MOVE IT TO PARMPKT MVI CALLTYP,C' ' NORMAL CALL CLI PARMTYP,C'R' IS THIS AN INIT REMOTE RECIEVE BE WESTART IF SO WE START THE INIT SETMAXL SR 11,11 CLEAR A REGISTER IC 11,PARMDAT GET MAX LENGTH L 3,=V(ETOA) NEED PACKETIO TRANS TABLE IC 11,0(11,3) CHANGE CHARACTER TO ASCII SH 11,=H'32' LOWER FROM PRINTABLE RANGE STC 11,PARMMAXL STORE AMOUNT IN PARM TABLE SETTIME SR 11,11 IC 11,=X'10' SET TIME TO WAIT TO 16 SECONDS AH 11,=H'32' SET UP IN PRINTABLE RANGE L 4,=V(ATOE) TRANS FROM PACKETIO TO EBCDIC IC 11,0(11,4) CHANGE TIME TO EBCDIC STC 11,PARMDAT+1 PUT IN PACKET TO SEND SETPAD SR 11,11 IC 11,PARMDAT+2 GET NUMBER OF PADDING CHARS IC 11,0(11,3) CONVERT IT TO ASCII BITS SH 11,=H'32' ADJUST DOWN FROM PRINTABLE STC 11,PARMNPAD STORE IN MY PARM LIST LH 11,=H'0' PUT SOME FILL CHARS IN AH 11,=H'32' GET UP TO PRINTABLE RANGE IC 11,0(11,4) TRANSLATE TO EBCDIC STC 11,PARMDAT+2 PUT IN PACKET TO SEND SETPADC SR 11,11 IC 11,PARMDAT+3 GET CHARACTER THEY ASKED FOR IC 11,0(11,3) TRANSLATE TO ASCII X 11,XORWRD USE CTL FUNCTION TO MOVE DOWN IC 11,0(11,4) TRANSLATE BACK TO EBCDIC STC 11,PARMPADC PUT IN PARM LIST SR 11,11 X 11,XORWRD USE CTL FUNCTION TO MOVE UP IC 11,0(11,4) SET TO EBCDIC CHAR STC 11,PARMDAT+3 TELL HIM I WANT NULLS(WHO CARES) SETEOL SR 11,11 IC 11,PARMDAT+4 GET EOL CHAR THEY WANT TO SEND IC 11,0(11,3) TRANSLATE TO ASCII SH 11,=H'32' IC 11,0(11,4) TRANSLATE BACK TO EBCDIC STC 11,PARMEOL PUT IN PARM LIST IC 11,=X'15' PUT IN MY <NL> CHARACTER IC 11,0(11,3) TRANSLATE TO ASCII AH 11,=H'32' SET UP TO PRINTABLE IC 11,0(11,4) TRANSLATE BACK TO EBCDIC STC 11,PARMDAT+4 SETQCTL IC 11,PARMDAT+5 GET QUOTE CHARACTER FOR CTL STC 11,PARMQCTL GOOD FOR ME TOO SETQBIN MVI PARMDAT+6,C'N' WE DONT DO 8 BIT QUOTING MVI PARMDAT+7,C'1' WE ONLY DO 1 BYTE CHECKSUMS SEQREPT IC 11,PARMDAT+8 GET A REPT QUOTE CHARACTER STC 11,PARMREPT GOOD ENOUGH FOR M MVI PARMDAT+9,X'00' WE HAVE NO EXTENSIONS MVI PARMTYP,C'Y' CHANGE PACKET TO AN ACK CLI CALLTYP,C'R' IS THIS INIT CAUSED BY A R PACKET BE ENDCALL WE ALREADY SENT OUT INIT PARAMS LA 1,ARGLIST L 15,=V(PACKETIO) CALL PACKET I/O FOR MESS SWAP BALR 14,15 ENDCALL L 11,=V(PIOINIT) GET PARAM LOCATION IN PACKETIO MVC 0(3,11),PARMNPAD MOVE NPAD, PADC, AND EOL CHARS GOBACK SR 11,11 CLEAR IT IC 11,PARMLEN GET THE LENGTH BCTR 11,0 DECREMENT BY 1 FOR EX MOVE EX 11,MOVEBK MOVE IT BACK TO CALLER RETURN L 13,SAVE+4 LM 14,12,12(13) SR 15,15 BR 14 WESTART LA 1,=A(PKINIT,PARMPKT) L 15,=V(PACKETIO) SEND BASIC INIT START BALR 14,15 CLI PARMTYP,C'E' BE GOBACK CLI PARMTYP,C'I' BE ISOK CLI PARMTYP,C'Y' BE ISOK B GOBACK ISOK MVI CALLTYP,C'R' THIS IS AN R PACKET INIT B SETMAXL GO UP AND GET PARAM ARGLIST DC A(PARMPKT) DC A(PARMPKT) XORWRD DC F'64' MOVEPKT MVC PARMPKT(1),0(2) MOVEBK MVC 0(1,2),PARMPKT CALLTYP DS CL1 SAVE DS 18F PARMPKT DS 0F PARMLEN DS XL1 PARMSEQ DS XL1 PARMTYP DS XL1 PARMDAT DS CL150 ENTRY KRMTPARM KRMTPARM EQU * PARMMAXL DS XL1 PARMTIME DS XL1 PARMNPAD DS XL1 PARMPADC DS CL1 PARMEOL DS CL1 PARMQCTL DS CL1 PARMQBIN DS CL1 PARMCHKT DS CL1 PARMREPT DS CL1 PARMCAPS DS X'00' PKINIT DS 0F PKILEN DC X'0C' PKISEQ DC X'00' PKITYP DC C'S' PKIMAXL DC X'FF' PKITIM DC C'-' PKINPAD DC C' ' PKIPADC DC C'@' PKIEOL DC C'-' PKIQCTL DC C'#' PKIQBIN DC C'N' PKICKTYP DC C'1' PKIQREPT DC C'_' END KRMTUC CSECT STM 14,12,12(13) BALR 12,0 USING *,12 ST 13,SAVE+4 LA 13,SAVE **************************************************** * ROUTINE TO CONVERT A 54 CHAR FIELD TO UPPER CS * **************************************************** L 2,0(1) GET ADDRESS OF THE FIELD LA 3,54 GET A COUNT IN REG 3 LOOPUC CLI 0(2),X'81' CHECK LOWER RANGE TO CHANGE BL NOCHNG IF LOW NO CHANGE CLI 0(2),X'A9' CHECK THE UPPER RANGE BH NOCHNG IF HIGH NO CHANGE OI 0(2),X'40' SET THE BIT FOR UPPER CASE NOCHNG LA 2,1(2) INCREMENT 2 BY 1 CLI 0(2),X'40' IS IS A BLANK BE RETURN IF SO NO MORE TO CHECK BCT 3,LOOPUC GO CHECK NEXT CHAR RETURN L 13,SAVE+4 GET THE SAVE AREA LM 14,12,12(13) SET REGISTERS BACK SR 15,15 ALL OK BR 14 AND BACK WE GO SAVE DS 18F END PACKETIO CSECT STM 14,12,12(13) BALR 12,0 USING *,12 ************************************************************** ** KERMIT I/O HANDELER ** ** USE: ** ** CONVERTS A PACKET FROM SIMPLE INTERNAL FORMAT ** ** TO KERMIT FORMAT AND SENDS IT ** ** RECIEVES THE ANS PACKET AND CONVERTS IT TO SIMPLE ** ** INTERNAL FORMAT ** ** RETRANSMITS FOR I/O ERRORS UNTIL TRANSACTION FINISH ** ** CALL FORMAT: ** ** STANDARD LINKAGE USAGE ** ** ARG #1 - ADDRESS OF PACKET TO SEND ** ** ARG #2 - ADDRESS OF PACKET TO RECIEVE ** ** INTERNAL PACKET FORMAT: ** ** <LENGTH> BINARY LENGTH INCLUSIVE ** ** <SEQ> PACKET SEQUENCE NUMBER IN BINARY ** ** <TYPE> CHARACTER REPRESENTING PACKET TYPE ** ** <DATA> VARIABLE LENGTH DATA FIELD ** ** LENGTH OF FIELD = <LENGTH>-3 ** ** PROCEDURE: ** ** A) PREFIX PACKET WITH A ^A FOR START OF PACKET ** ** B) PREFIX PACKET WITH LENGTH AND STUFF FOR A ** ** UNIVAC V TYPE RECORD ** ** C) CONVERT <LENGTH>&<SIZE> TO CHAR ADJUSTED FORM ** ** D) CALCULATE A CHECK SUM BASED ON ASCII REP ** ** F) SUFFIX PACKET WITH A CARRAGE RETURN ** ** EBCDIC <NL> X'15' = ASCII <CR> X'0D' ** ** G) SEND THE PACKET AND GET THE RETURN PACKET ** ** H) CONVERT THE RETURN PACKET TO SIMPLE FORM ** ** I) RETURN THE PACKET TO THE CALLER ** ** ERRORS: ** ** ALL ERRORS CAUSE THE ORIGINAL PACKET TO BE SENT ** ** AGAIN. (THIS SHOULD BE OK; DUPE PACKETS ARE DROP)** ** ERRORS WHICH ARE INTERCEPTED ARE: ** ** RTIO ERROR - UNIVAC BUFFER OVERRUN ** ** CHECKSUM - ERROR ON CHECKSUM ON RETURNING PACK ** ** NAK - PACKET SENT WAS NAK'ED BY REMOTE ** ************************************************************** SPACE SPACE ************************************************************** ** BUILD THE PACKET TO GO OUT ** ************************************************************** L 3,0(1) GET ADDRESS PACKET TO SEND L 4,4(1) GET ADDRESS OF PACKET SR 5,5 CLEAR A REG FOR ERROR COUNT SENDAGN SR 11,11 CLEAR OUT A TEMP REG C 5,=F'50' CHECK FOR ERROR ABORT BH TERMD LETS GET THAT DUMP IC 11,0(3) GET THE LENGTH OF PACKET EX 11,MOVEPK MOVE TO LOCAL(YES 1 EXTRA CHAR) MVI SENDMRK,X'27' MOVE IN ^A FOR START OF PACKET LA 11,8(11) GET LENGTH FOR V RECORD STH 11,SENDVREC STORE IT IN BEGINNING OF BUFFER MVC SENDFIL,=X'4040' BLANKS TO KEEP UNIVAC HAPPY MVI SENDNUL,X'00' MOVE IN A NUL AT START OF LINE SR 11,11 CLEAR IT AGAIN IC 11,SENDLEN GET THE LENGTH AGAIN STC 11,SAVELEN SAVE LENGTH FOR LATER USE AH 11,=H'32' MOVE UP TO PRINTABLE STC 11,SENDLEN PUT BACK IN PACKET TR SENDLEN,ATOE TRANS TO EBCDIC FOR LATER ASCII SR 11,11 CLEAR 11 FOR SAME TO SEQUENCE IC 11,SENDSEQ GET THE SEQUENCE NUMBER AH 11,=H'32' ADJUST UP TO PRINTABLE STC 11,SENDSEQ PUT BACK IN PACKET RECORD TR SENDSEQ,ATOE TRANS TO EBCDIC FOR LATER ASCII CVT SR 11,11 CLEAR TEMP REGISTER AGAIN IC 11,SAVELEN GET ORIGINAL BINARY LENGTH EX 11,MOVETS MOVE PACKET TO TEMP STORAGE EX 11,TRANTS TRANSLATE TEMPORARY TO ASCII SR 10,10 CLEAR ANOTHER REGISTER FOR TEMP SR 9,9 CLEAR A REGISTER FOR SUM LR 8,11 POINT TO LAST CHAR (CHECKSUM) LOOPCKSM IC 10,TEMPS-1(8) GET NEXT CHAR IN STRING AR 9,10 ADD TO SUM BCT 8,LOOPCKSM GO BACK FOR MORE CHARS N 9,ZAPHIGH GET RID OF HIGH 3 BYTES LR 8,9 COPY TO 8 SRL 8,6 SHIFT RIGHT 6 BITS TO LEAVE HIGH 2 AR 9,8 ADD IT TO THE SUM N 9,ZAPBUT6 ZAP ALL BUT LAST 6 BITS AH 9,=H'32' MOVE UP TO PRINTABLE RANGE IC 9,ATOE(9) CONVERT TO EBCDIC STC 9,SENDLEN(11) PUT AT END OF PACKET IC 8,CARRET GET A CARRAGE RETURN/NEW LINE STC 8,SENDLEN+1(11) PUT AFTER THE CHECK SUM ************************************************************** ** NOW THAT A PACKET IS READY TO GO WE WILL SEND IT TO ** ** THE REMOTE DEVICE VIA TERMINAL LINE AND WAIT FOR THE ** ** RETURN PACKET FROM THE REMOTE ** SR 11,11 CLEAR REG IC 11,NPAD GET NUMBER OF PAD CHARS LTR 11,11 SEE IF ZERO BZ WTRD DO THE WRITE NOW MVC TEMPS(1),PADC MOVE IN PAD CHARACTER MVC TEMPS+1(150),TEMPS AH 11,=H'5' ADD FOR RECLEN STH 11,TEMPS PUT IN THE RECORD MVC TEMPS+2(2),=C' ' PUT IN BLANKS KEEP UNI HAPPY WROUT TEMPS,X'16' WRITE OUT THE NULLS (NO CR) WTRD LTR 4,4 CHECK RETURN PACKET ADDR BZ SENDONLY IF ZERO WE SEND AND RETURN WRTRD SENDPK,X'16',TEMPS,X'16',150,RTIOERR ************************************************************** ** INPUT BUFFER (TEMPS) SHOULD HAVE A PACKET. FIRST WE MUST ** ** FIND THE ^A TO START THE PACKET AND DROP TRASH ** ************************************************************** TRT TEMPS+4(L'TEMPS-4),TABCTLA BZ RTIOERR ^A NOT FOUND LA 11,TEMPS-1 ADDRESS OF START OF PACKET LH 10,TEMPS LENGTH OF STRING (V REC) LR 9,1 ADDRESS OF ^A N 9,ZAPADDR N 11,ZAPADDR GET RID OF FIRST BY ADDRESS CONST SR 9,11 AMOUNT OF TRASH BEFORE ^A AR 11,9 ADD LENGHT OF TRASH TO START SR 10,9 GET LENGHTOF GOOD DATA LR 8,10 SAVE LENGHT OF GOOD DATA(TEMP) BCTR 10,0 DECREMENT BY 1 FOR EX TYPE MOVE EX 10,MOVEGT MOVE IT TO THE "GET" PACKET *************************************************************** ** THE GOOD PART OF THE PACKET IS IN THE "GET" AREA ** ** MUST BE CHECKED FOR CHECKSUM OR NAK ** *************************************************************** SR 11,11 CLEAR OUT A TEMP REG IC 11,GETLEN GET THE EBCDIC LENGTH(NOT READY) IC 11,ETOA(11) TRANSLATE CHAR TO ASCII SH 11,=H'32' DOWN FROM PRINTABLE TO BINARY BM RTIOERR THIS PACKET LENGTH IS BAD SR 8,11 GET DIFF BETWEEN V LEN AND PACKET C 8,=F'5' IS THE DIFF MORE THAN 5 BH RTIOERR C 8,=F'-5' IS DIFF LESS THAN 5 BL RTIOERR EX 11,MOVEGTP MOVE IT TO TEMP STORAGE EX 11,TRANTS TRANSLATE IT TO ASCII LR 10,11 POINT TO LAST CHAR SR 9,9 CLEAR FOR SUM SR 8,8 CLEAR FOR TEMP USE LOOPCK IC 8,TEMPS-1(10) GET A CHARACTER AR 9,8 ADD IT TO THE SUM BCT 10,LOOPCK GO BACK FOR MORE CHARS? N 9,ZAPHIGH CLEAR ALL BUT LAST BYTE LR 10,9 COPY TO REG 10 SRL 10,6 MOVE HIGH 2 BITS OF BYTE TO LOW BITS AR 9,10 ADD THOSE BITS TO THE SUM N 9,ZAPBUT6 CLEAR ALL BUT LAST 6 BITS AH 9,=H'32' ADD TO COMPAIR IN PRINTABLE RANGE IC 10,TEMPS(11) GET THE CHECKSUM RECIEVED CR 9,10 ARE THEY THE SAME BNE RTIOERR IF NOT LETS TRY AGAIN ************************************************************** ** THIS LOOKS LIKE A GOOD PACKET. NEXT TO CHANGE THE BINARY ** ** FIELDS FROM THEIR EBCDIC CHAR TRANSLATION ** ************************************************************** CLI GETTYP,C'N' IS THE PACKET A NAK BE RTIOERR IF SO LETS TRY AGAIN SR 11,11 CLEAR IT IC 11,TEMPS+1 GET ASCII REP FOR SEQUENCE SH 11,=H'32' MOVE IT DOWN STC 11,GETSEQ PUT IT IN THE PACKET TO RETURN IC 11,TEMPS GET THE ASCII REP FOR LENGTH SH 11,=H'32' MOVE IT DOWN FROM PRINTABLE STC 11,GETLEN PUT IN PACKET TO RETURN BCTR 11,0 DECREMENT IT FOR THE MOVE EX 11,MOVEBK MOVE IT BACK TO CALLER RETURN LM 14,12,12(13) RESTORE CALLERS REGISTERS SR 15,15 ALL IS OK BR 14 AND BACK TO THE CALLER RTIOERR LA 5,1(5) INCREMENT I/O ERROR COUNT B SENDAGN GO BACK AND SEND AGAIN SENDONLY WROUT SENDPK,X'16' B RETURN AND BACK WE GO TERMD TERMD ENTRY ATOE,ETOA ATOE DC X'00270303030303030303030303150303' DC X'03030303030303030303030303030303' DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' DC X'D7D8D9E2E3E4E5E6E7E8E9B4BCB56A6D' DC X'4A818283848586878889919293949596' DC X'979899A2A3A4A5A6A7A8A9C04FD0FF07' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' DC X'03030303030303030303030303030303' ETOA DC X'000303030303037F0303030303030303' DC X'03030303030D03030303030303030303' DC X'03030303030303010303030303030303' DC X'03030303030303030303030303030303' DC X'20030303030303030303602E3C282B7C' DC X'2603030303030303030321242A293B03' DC X'2D2F03030303030303035E2C255F3E3F' DC X'030303030303030303033A2340273D22' DC X'03616263646566676869030303030303' DC X'026A6B6C6D6E6F707172030303030303' DC X'0303737475767778797A030303030303' DC X'030303035B5D0303030303035C030303' DC X'7B414243444546474849030303030303' DC X'7D4A4B4C4D4E4F505152030303030303' DC X'0303535455565758595A030303030303' DC X'3031323334353637383903030303037E' TABCTLA DC 256X'00' ORG TABCTLA+X'27' CTRLA DC X'27' ORG SAVELEN DS CL1 ENTRY PIOINIT PIOINIT EQU * NPAD DS XL1 PADC DS CL1 CARRET DC X'15' MOVETS MVC TEMPS(1),SENDLEN MOVEGTP MVC TEMPS(1),GETLEN TRANTS TR TEMPS(1),ETOA MOVEPK MVC SENDLEN(1),0(3) MOVEGT MVC GETLEN(1),1(11) MOVEBK MVC 0(1,4),GETLEN DS 0F ZAPHIGH DC X'000000FF' ZAPBUT6 DC X'0000003F' ZAPADDR DC X'00FFFFFF' LTORG SENDPK DS 0F SENDVREC DS H SENDFIL DS XL2 SENDNUL DS XL1 SENDMRK DS CL1 SENDLEN DS CL1 SENDSEQ DS CL1 SENDTYP DS CL1 SENDDATA DS CL150 SAFE1 DS CL256 DS 0F TEMPS DS CL150 SAFE2 DS CL256 GETPK DS 0F GETLEN DS CL1 GETSEQ DS CL1 GETTYP DS CL1 GETDATA DS CL150 SAFE3 DS CL256 END SENFILE CSECT STM 14,12,12(13) BALR 12,0 USING *,12 ST 13,SAVE+4 LA 13,SAVE *********************************************************** ** ROUTINE TO SEND A FILE ** *********************************************************** L 3,0(1) GET THE ADDRESS OF PACKET SR 11,11 CLEAR IT IC 11,0(3) GET THE LENGTH BCTR 11,0 DECREMENT BY 1 FOR MVC EX 11,MOVELCL MOVE THE PACKET TO LOCAL MVI INFCB+X'2E',C' ' MVC INFCB+X'2F'(53),INFCB+X'2E' SH 11,=H'3' SUBTRACT FOR LEN,SEQ,TYP EX 11,MOVEFIL MOVE THE FILE NAME TO FCB LA 1,=A(INFCB+X'2E') L 15,=V(KRMTUC) BALR 14,15 MVC FILECMD+12(54),INFCB+X'2E' LA 1,=A(PACKET) SET UP PARM FOR SUB CALL L 15,=V(KRMTINI) GET READY TO DO AN INIT BALR 14,15 AND OFF WE GO CLI PKTYP,C'E' BE RETURN CLI PKTYP,C'Y' IS IT AN ACK FOR INIT BE ISOKACK YES WE CAN GO ON B RETURN ABORT TERMD ISOKACK MVI PKTYP,C'F' START BUILDING A FILE PACKET MVC PKDAT(54),FILECMD+12 LA 11,PKDAT+53 POINT TO THE END OF PACKET LOOKEND CLI 0(11),C' ' IS THIS A BLANK CHAR BNE HAVEEND BCT 11,LOOKEND LOOK FOR THE END OF FILENAME HAVEEND LA 10,PACKET GET START OF PACKET SR 11,10 GET LENGTH IN 11 LA 11,1(11) INCREMENT TO MAKE INCLUSIVE STC 11,PKLEN PUT IT IN THE LENGTH BAL 14,INCSEQ SR 10,10 CLEAR A TEMP REGISTER SR 11,11 CLEAR A SECOND TEMP REGISTER LA 1,ARGLIST SEND ARG LIST OF PACKET,PACKET L 15,=V(PACKETIO) BALR 14,15 SEND THE F PACKET CLI PKTYP,C'Y' DID WE GET FILE ACK BNE RETURN PRINT NOGEN FILECMD FILE DUMMYFILE PRINT GEN OPEN INFCB,INPUT OPEN THE INPUT FILE L 11,=V(KRMTPARM) SR 7,7 IC 7,0(11) GET MAX PACKET LENGTH SH 7,=H'3' SUBTRACT LEN,TYP,SEQ *************************************************************** ** WE HAVE SENT AN INIT PACKET (SEE KRMTINI) ** ** ALSO HAVE SENT AN F PACKET WITH THE FILE NAME IN IT ** ** AND THE FILE SHOULD BE OPEN FOR INPUT AT THIS POINT ** *************************************************************** SR 11,11 SR 4,4 CLEAR A POINTER TO RECORD SR 5,5 CLEAR A POINTER TO DATA SR 9,9 GETREC GET INFCB,RECLEN GET A RECORD FROM THE FILE LH 6,RECLEN GET LENGTH OF RECORD SH 6,=H'4' SUBTRACT LENGTH OF V REC FORMAT MOVECHR IC 11,RECORD(4) GET NEXT CHARACTER FROM RECORD L 8,=V(ETOA) NEED ADDRESS OF TRANSLATION TABLE IC 10,0(11,8) GET ASCII VALUE OF CHARACTER EX 10,TESTBAD CHECK FOR A NON PRINTABLE CHAR BNE NOZAP NOT CHANGED TO TILD ZAPIT IC 11,=X'6D' MAKE THIS A TILD CHARACTER NOZAP STC 11,TESTCHR PUT IT IN MEMORY CLI TESTCHR,X'00' GET RID OF NULLS BE ZAPIT CLI TESTCHR,X'0D' IS IT A DEL CHARACTER BE ZAPIT GET RID OF THAT ALSO CLI TESTCHR,X'01' IS IT A CONTROL A BE ZAPIT CLI TESTCHR,X'FF' BE ZAPIT CLI TESTCHR,C'#' IS THIS A # BNE NORMCH NO PROCESS NORMAL STC 11,PKDAT(5) PUT IN FIRST # LA 5,1(5) INCREMENT IN BUFFER CR 5,7 WILL THERE BE ROOM FOR NEXT # BL STORECH YES GO PUT IT IN BCTR 5,0 TAKE OFF THE ONE WE PUT IN BAL 2,WRITEPK WRITE THE SHORT PACKET IC 11,=C'#' GET BACK THE # STC 11,PKDAT(5) PUT ONE IN LA 5,1(5) INCREMENT POINTER B STORECH PUT IN THE SECOND ONE NORMCH CLC TESTCHR,LASTCHR IS THIS THE SAME AS LAST BE INCCNT IF SO INC THE REPT COUNT SR 9,9 SET CHAR COUNT TO ZERO MVC LASTCHR,TESTCHR MOVE THIS TO LAST INCCNT LA 9,1(9) INCREMENT BY 1 CH 9,=H'4' HOW MANY DO WE HAVE BL STORECH NOT ENOUGH STC 11,PKDAT-1(5) PUT THE CHAR IN IC 11,=X'FF' GET A TILD STC 11,PKDAT-3(5) PUT TILD IN FOR QUOTE L 8,=V(ATOE) TRANS TO EBCDIC CHAR IC 11,32(8,9) GET ASCII VALUE OF AMT STC 11,PKDAT-2(5) CH 9,=H'94' BL INCDPTR MVI LASTCHR,X'FE' B INCDPTR STORECH STC 11,PKDAT(5) PUT THE CHARACTER IN OUTPUT LA 5,1(5) INCREMENT DATA POINTER INCDPTR LA 4,1(4) INCREMENT RECORD POINTER CR 5,7 IS MORE ROOM IN PACKET BL CHECKREC IF YES IS MORE DATA IN REC SKIPWRT BAL 2,WRITEPK WRITE A PACKET CHECKREC CR 4,6 IS MORE DATA IN CURRENT RECORD BL MOVECHR PROCESS REST OF RECORD SR 9,9 SET REPT COUNT TO ZERO LR 11,5 GET LENGTH USED IN PACKET LA 11,4(11) WILL THERE BE ROOM FOR QUOTED CHAR CR 11,7 BNL SKIPWRT WE HAVE ROOM NO NEED TO WRITE IC 11,=C'#' GET A PREFIX CHAR STC 11,PKDAT(5) PUT IT IN THE RECORD IC 11,=C'M' GET A 'M' FOR ^M LA 5,1(5) INCREMENT BY 1 STC 11,PKDAT(5) PUT IT IN THE RECORD IC 11,=C'#' QUOTE AGAIN LA 5,1(5) GO TO NEXT POSITION STC 11,PKDAT(5) LA 5,1(5) IC 11,=C'J' STC 11,PKDAT(5) LA 5,1(5) RECORD IS FINISHED SR 4,4 CLEAR RECORD POINTER FOR NEXT CR 5,7 DID WE FILL THE BUFFER BL GETREC BAL 2,WRITEPK GO TO LOCAL RTN TO WRITE PACKET B GETREC GO GET ANOTHER RECORD INCSEQ IC 11,PKSEQ LA 11,1(11) STC 11,PKSEQ NI PKSEQ,63 BR 14 WRITEPK MVI PKTYP,C'D' SET PACKET TYPE TO DATA SR 11,11 BAL 14,INCSEQ LA 5,3(5) ADD FOR LEN,TYPE,SEQ STC 5,PKLEN STORE IT IN THE LENGTH LA 1,ARGLIST GET ADDRESS LIST FOR SUB CALL L 15,=V(PACKETIO) GET ROUTINE TO WRITE PACKET BALR 14,15 AND WRITE IT OUT CLI PKTYP,C'Y' DID WE GET AN ACK BNE ERRCLS NO ABORT THIS RUN SR 5,5 THE NEW PACKET IS EMPTY SR 9,9 REPT COUNT IS ZERO BR 2 GO BACK TO CALLER EOF LTR 5,5 WAS THERE DATA IN A PACKET BZ WRITEZ NO CLOSE THE TRANSMISSION BAL 2,WRITEPK WRITE LAST PACKET WRITEZ MVI PKTYP,C'Z' END OF FILE PACKET CLOSE INFCB REMEMBER TO CLOSE THE INPUT SR 11,11 BAL 14,INCSEQ MVI PKLEN,X'03' SET LENGTH TO 3 LA 1,ARGLIST GET READY TO CALL PACKETIO L 15,=V(PACKETIO) BALR 14,15 SEND THAT PACKET GET AN ACK CLI PKTYP,C'E' BE RETURN CLI PKTYP,C'Y' WAS IT AN ACK BNE RETURN LETS GET A DUMP MVI PKTYP,C'B' BUILD A BREAK PACKET BAL 14,INCSEQ MVI PKLEN,X'03' SET THE LENGTH TO 3 L 15,=V(PACKETIO) BALR 14,15 CLI PKTYP,C'E' BE RETURN CLI PKTYP,C'Y' THE BREAK SHOULD BE ACKED BNE RETURN IF NOT ABORT AGAIN RETURN SR 11,11 IC 11,PKLEN GET THE LENGTH BCTR 11,0 DECREMENT BY 1 EX 11,MOVEBK MOVE THE PACKET BACK TO CALLER L 13,SAVE+4 GET WHERE I PUT CALLERS REGISTERS LM 14,12,12(13) RESTORE THOSE REGISTERS SR 15,15 ALL OK BR 14 NOFILE LA 1,=A(D33ERR,PACKET) L 15,=V(PACKETIO) BALR 14,15 B RETURN ERRCLS CLOSE INFCB B RETURN SAVE DS 18F D33ERR DC YL1(ED33-*) D33PKN DC X'00' D33PKT DC C'E' D33PKD DC C'OPEN ERROR OCCURED ON FILE OPEN' ED33 EQU * ARGLIST DC A(PACKET) DC A(PACKET) PACKET DS 0F PKLEN DS XL1 PKSEQ DS XL1 PKTYP DS CL1 PKDAT DS CL150 MOVELCL MVC PACKET(1),0(3) TARGET MOVE TO GO TO LOCAL STORAGE MOVEBK MVC 0(1,3),PACKET TARGET MOVE TO GOT BACK TO CALLER MOVEFIL MVC INFCB+X'2E'(1),PKDAT TESTBAD CLI BADCHR,X'00' BADCHR DC X'03' TESTCHR DS CL1 LASTCHR DS CL1 PRINT NOGEN DS 0D INFCB FCB LINK=KRMOUT,FCBTYPE=SAM,RECFORM=V,EXIT=EXLST EXLST EXLST COMMON=NOFILE,EOFADDR=EOF UNIREC DS 0F RECLEN DS H REDFIL DS CL2 RECORD DS CL1000 END RECFILE CSECT STM 14,12,12(13) BALR 12,0 USING *,12 ST 13,SAVE+4 LA 13,SAVE SET UP MY SAVE AREA *********************************************************** ** ROUTINE TO RECIEVE A FILE FROM REMOTE KERMIT ** ** FIRST WE MUST CHECK FOR AN S TYPE PACKET WHICH WOULD ** ** REQUIRE WE ACK WITH INIT PARAMS USING KRMTINI ROUTINE ** *********************************************************** L 2,0(1) GET ADDRESS OF PACKET IC 11,0(2) GET THE LENGTH OF THE PACKET BCTR 11,0 DECREMENT BY 1 FOR MVC EX 11,MOVELCL MOVE TO LOCAL STORAGE CLI PKTYP,C'S' IS IT THE INIT PACKET BNE SKIPINI IF NOT WE DONT NEED INIT LA 1,=A(PACKET) SET UP AN ARG LIST FOR CALL L 15,=V(KRMTINI) GET ADDRESS OF INIT ROUTINE BALR 14,15 OFF WE GO FOR THE INIT CLI PKTYP,C'E' BE RETURN ************************************************************ ** HAVING INIT THE CONNECTION IT IS TIME TO SET UP THE ** ** FILE TO BE TRANSFERED ** ************************************************************ SKIPINI CLI PKTYP,C'F' SHOULD BE A FILE NAME BNE RETURN WE REALLY NEED A FILE NAME L 11,=V(KRMTPARM) GET ADDRESS OF INIT PARAM MVC CTLCHR,5(11) GET THE CONTROL QUOTE CHAR MVC REPTCHR,8(11) GET THE REPT QUOTE CHAR MVI FILEFCB+X'2E',C' ' MVC FILEFCB+X'2F'(53),FILEFCB+X'2E' IC 11,PKLEN GET LENGTH OF PACKET SH 11,=H'4' SUBTRACT LEN,SEQ,TYP,+1 EX 11,MOVENAME MOVE NAME IN CLEAN FIELD LA 1,=A(FILEFCB+X'2E') L 15,=V(KRMTUC) BALR 14,15 CONVERT FILENAME TO UPPER CASE MVC FILECMD+12(54),FILEFCB+X'2E' FILECMD FILE DUMMYFILE OPENFL OPEN FILEFCB,OUTPUT OPEN THE FILE ************************************************************* ** FILE IS OPEN AND WE ARE READY TO START THE TRANSFER ** ** WE SHOULD BE PROCESSING 'D' PACKETS AT THIS TIME ** ** P.S. SORRY ABOUT THE SLOPPY WAY OF REFF FILE NAME IN ** ** UNIVAC FCB = FCB+X'2E' IT WASN'T WORTH THE COMPILE** ** TIME TO INCLUDE THE IDFCB AND COVER IT WITH A REG ** ************************************************************* MVC PKASEQ,PKSEQ LA 1,=A(PKACK,PACKET) L 15,=V(PACKETIO) ACK FILE NAME GET FIRST D BALR 14,15 CLI PKTYP,C'D' BNE ERRCLS SR 10,10 CLEAR RECORD POINTER SR 8,8 CLEAR TEMP REG SR 9,9 START AT BEG OF DATA FIELD SR 11,11 CLEAR REG FOR COUNT IC 11,PKLEN PUT IN THE LENGTH SH 11,=H'3' REMOVE LEN TYP AND SEQ FIELDS LOOPCHR BAL 4,GETNEXT GET THE NEXT CHARACTER IN 8 EX 8,TESTCTL TEST FOR A CONTROL PREFIX BE PROCCTL PROCESS A CONTROL CHAR EX 8,TESTREPT TEST FOR REPT BE PROCREPT PROCESS THE REPT CHAR EX 8,TESTEND BE PROCEND PROCESS AN END OF FILE TAKECHR STC 8,RECORD(10) PUT IT IN THE RECORD LA 10,1(10) INCREMENT RECORD POINTER C 10,=F'2000' HAVE WE REACHED THE END OF REC BE ENDFILE PRETEND WE HAD A LINE FEED B LOOPCHR GO FOR MORE PROCCTL BAL 4,GETNEXT GET NEXT CHARACTER STC 8,TEMPCHR PUT IN MEMORY FOR CLI CLI TEMPCHR,C'M' IS IT A CARRAGE RETURN ^M BE LOOPCHR WE DONT NEED IT CLI TEMPCHR,C'J' IS IT A LINE RETURN BE ENDREC YES WRITE THE RECORD CLI TEMPCHR,C'#' IS THIS A # SIGN QUOTED WITH A # BE TAKECHR WELL WE WILL KEEP IT IC 8,=X'FF' GIVE THEM A FLAG OF BAD CHAR B TAKECHR PUT IT IN THE OUTPUT REC ENDREC LTR 10,10 IS THERE ANY LENGTH TO REC BNZ WRITEOK YES NO BLANK NEEDED LA 10,1(10) ADD 1 TO LENGTH IC 1,=C' ' STC 1,RECORD(10) PUT A BLANK IN THE RECORD WRITEOK AH 10,=H'4' ADD FOR UNIVAC V REC STH 10,RECLEN PUT IT IN THE LENGTH MVC RECFIL,=C' ' PUT IN V FILL CHARS PUT FILEFCB,RECLEN WRITE THE RECORD (USING MOVE MODE) SR 10,10 CLEAR THE RECORD POINTER B LOOPCHR GO PROCESS MORE CHARACTERS PROCREPT BAL 4,GETNEXT GET THE NEXT CHAR(REPT COUNT) L 5,=V(ETOA) NEED IT IN ASCII IC 8,0(5,8) CHANGE IT SH 8,=H'32' MOVE IT DOWN FROM PRINTABLE LR 7,8 HOLD THAT COUNT BAL 4,GETNEXT AND WHAT CHAR DO WE NEE EX 8,TESTCTL IS THE REPT CHAR A CTL BNE LOOPINS GOOD NO INSERT IT BAL 4,GETNEXT WHAT IS THE UNCTL CHAR STC 8,TEMPCHR PUT IN MEMORY CLI TEMPCHR,C'J' IS IT A LINEFEED BE WRITEBLK WRITE THIS AND BLANK LINES CLI TEMPCHR,C'#' IS THIS A LOUSY # SIGN BE LOOPINS WELL WE WILL KEEP IT IC 8,=X'FF' CHANGE IT TO FLAG CHAR LOOPINS STC 8,RECORD(10) PUT IT IN THE RECORD LA 10,1(10) GO UP BY 1 BCT 7,LOOPINS KEEP DOING IT FOR COUNT IN 7 B LOOPCHR GO FOR MORE WRITEBLK AH 10,=H'4' MAKE THE UNIVAC V RECORD LENGHT STH 10,RECLEN PUT IN RECORD MVC RECFIL,=C' ' AND BLANKS PUT FILEFCB,RECLEN WRITE IT BCT 7,LOOPBLK GO FOR MORE(REPT OF 1 LOOSER) B LOOPCHR LOOPBLK PUT FILEFCB,BLKREC WRITE A PREFORMATTED BLANK REC BCT 7,LOOPBLK GO BACK FOR MORE B LOOPCHR GO FOR MORE CHARS. *********************************************************** ** ROUTINE (GETNEXT) TO GET THE NEXT CHARACTER FROM INPUT** ** IF NECESSARY IT WILL ACK THE LAST PACKET AND GET NEXT** *********************************************************** GETNEXT CR 9,11 ARE THERE MORE IN BUFFER BL TAKENEXT YES GO GET THE NEXT CHAR ACKPACK MVC PKASEQ,PKSEQ MOVE THE SEQ NUMBER TO ACK LA 1,=A(PKACK,PACKET) L 15,=V(PACKETIO) GO FOR ANOTHER PACKER BALR 14,15 CLI PKTYP,C'E' BE ERRCLS SR 9,9 SET POINTER TO BEG OF PACKET IC 11,PKLEN PUT LENGTH IN 11 SH 11,=H'3' DECREMENT FOR LEN,TYP,SEQ TAKENEXT CLI PKTYP,C'D' IS THIS A DATA PACKET BNE ENDFILE YES SEND A ^B TO END FILE IC 8,PKDAT(9) GIVE HIM THE CHARACTER LA 9,1(9) INCREMENT DATA POINTER BR 4 GO BACK TO CALLER ENDFILE IC 8,=X'02' GIVE HIM A ^B BR 4 AND GO BACK *********************************************************** ** ROUTINE ON END OF FILE ** *********************************************************** PROCEND LTR 10,10 IS ANYTHING IN BUFFER BZ SKIPWRT NOTHING TO WRITE AH 10,=H'4' ADD FOR V TYPE REC STH 10,RECLEN PUT IN THE RECORD MVC RECFIL,=C' ' PUT IN BLANK FOR FILL PUT FILEFCB,RECLEN AND WRITE IT TO THE FILE SKIPWRT CLOSE FILEFCB CLOSE THE FILE CLI PKTYP,C'Z' IS THIS A REAL END OF FILE BNE RETURN DONT KNOW WHAT ELSE IT IS MVC PKASEQ,PKSEQ ACK THE END OF FILE LA 1,=A(PKACK,PACKET) L 15,=V(PACKETIO) GET THE NEXT PACKET BALR 14,15 CLI PKTYP,C'E' BE RETURN DONEXT CLI PKTYP,C'F' IS THIS A NEW FILE HEADER BE SKIPINI START ANOTHER FILE CLI PKTYP,C'B' IS THIS A BREAK IN TRANS BNE RETURN MVC PKASEQ,PKSEQ GET READY TO ACK BREAK LA 1,=A(PKACK,PACKET) L 15,=V(PACKETIO) BALR 14,15 RETURN IC 11,PKLEN GET THE LENGTH OF PACKET BCTR 11,0 DECREMENT BY 1 EX 11,MOVEBK MOVE IT BACK (REM REG 2) L 13,SAVE+4 GET ADDRESS OF OUT REGS LM 14,12,12(13) RESTORE THE REGISTERS SR 15,15 ALL IS OK BR 14 BACK WE GO TO CALLER BADOPN LA 1,=A(BADPK,PACKET) L 15,=V(PACKETIO) BALR 14,15 B RETURN ERRCLS CLOSE FILEFCB B RETURN ABORT TERMD LTORG SAVE DS 18F TEMPCHR DS CL1 MOVEBK MVC 0(1,2),PACKET TESTCTL CLI CTLCHR,X'00' TESTREPT CLI REPTCHR,X'00' TESTEND CLI ENDCHR,X'00' MOVELCL MVC PACKET(0),0(2) MOVENAME MVC FILEFCB+X'2E'(1),PKDAT CTLCHR DC C'#' REPTCHR DC C'_' ENDCHR DC X'02' BADPK DC YL1(ENDBAD-*) DC X'00' DC C'E' DC C'OPEN FAILED FOR OUTPUT FILE' ENDBAD EQU * PACKET DS 0F PKLEN DS XL1 PKSEQ DS XL1 PKTYP DS XL1 PKDAT DS CL150 PKACK DS 0F PKALEN DC X'03' PKASEQ DS XL1 PKATYP DC C'Y' BLKREC DC H'5' DC C' ' EXPRM EXLST COMMON=BADOPN,OPENER=BADOPN FILEFCB FCB FCBTYPE=SAM,LINK=KRMFL,RECFORM=V,EXIT=EXPRM RECLEN DS H RECFIL DS CL2 RECORD DS CL2000 END